module SysUtils
use OptimisationTypes
implicit none
contains


subroutine MessageOut(Opt, M)
   implicit none
   type(TOptimisation), intent(in) :: Opt
   character(len = *) :: M
   open(cMessageFile, file = GetWorkFileName(Opt, s_LogFile), action = 'write', position =  'append')
   write(cMessageFile,*) M
   close(cMessageFile)
end subroutine MessageOut


function GetFileName(FileDir, FileName)
   implicit none
   character(len = *), intent(in) :: FileDir, FileName
   character(len = 256) :: GetFileName
   GetFileName = lrtrim(lrtrim(FileDir) // "/" // lrtrim(FileName))
end function GetFileName


function GetWorkFileName(Opt, FileName)
   implicit none
   type(TOptimisation) :: Opt
   character(len = *), intent(in) :: FileName
   character(len = 256) :: GetWorkFileName
   GetWorkFileName = lrtrim(GetFileName(lrtrim(Opt%ProjectDir), &
      lrtrim(lrtrim(Opt%RunName) // "/" // lrtrim(FileName))))
end function GetWorkFileName


function GetDataFileName(Opt, FileName)
   implicit none
   type(TOptimisation) :: Opt
   character(len = *), intent(in) :: FileName
   character(len = 256) :: GetDataFileName
   GetDataFileName = lrtrim(GetFileName(lrtrim(Opt%ProjectDir), &
      lrtrim(lrtrim(s_DataFolder) // "/" // lrtrim(FileName))))
end function GetDataFileName


!subroutine DeleteFile(FileName)
!   implicit none
!   character(len = *) :: FileName
   !character(len = 256) :: Cmd
!   integer :: ioerr
   !Cmd = 'del "' // lrtrim(FileName) // '""'
   !call system(lrtrim(Cmd))
!   open(cFileUnit, file = FileName, action = 'read', iostat=ioerr, status = 'scratch')
!   close(cFileUnit)
!end subroutine DeleteFile


function OpenFile(Opt, Handle, FileName, ForOutput)
   implicit none
   type(TOptimisation) :: Opt
   integer :: Handle, ioerr
   logical :: OpenFile
   character(len = *) :: FileName
   character(len=10) :: ActionStr, StatusStr
   logical :: ForOutput
   if(ForOutput) then
      ActionStr = "write"
      StatusStr = "replace"
   else
      Opt%CurrentInputFile = FileName
      Opt%CurrentInputLine = 1
      ActionStr = "read"
      StatusStr = "old"
   endif
   open(Handle, file = FileName, action = ActionStr, iostat = ioerr, status = StatusStr)
   if (ioerr > 0) then
      Opt%ErrorStr = "Error opening " // lrtrim(FileName) // ". The file may not exist"
      call MessageOut(Opt, Opt%ErrorStr)
      OpenFile = .false.
   else
      OpenFile = .true.
      call MessageOut(Opt, "Opening " // lrtrim(FileName) // " succeeded.")
   endif
end function OpenFile


function ReadStrFromFile(Opt, Handle, Str)
   implicit none
   type(TOptimisation) :: Opt
   integer :: Handle
   character(len=*) :: Str
   character(len=3) :: advanceStr
   character(len=256) :: DESCR
   logical :: ReadStrFromFile
   integer :: errstat

   read(Handle, "(A)", iostat = errstat) Str
   if(lrtrim(Str) == "") then
      errstat = 1
      DESCR = "Empty line."
   endif
   ReadStrFromFile = (errstat == 0)   
   if(errstat /= 0) then
      Opt%ErrorStr = "Error reading line no. " // lrtrim(inttostr(Opt%CurrentInputLine)) // " in " // &
         lrtrim(Opt%CurrentInputFile) // ". " // DESCR // "."
      close(Handle)
   else
      Opt%CurrentInputLine = Opt%CurrentInputLine + 1
   endif
end function ReadStrFromFile 


function ReadSFromFile(Handle, s2, decfound, eoffound)
   implicit none
   integer :: Handle
   character(len=256) :: s, s2
   logical :: ReadSFromFile, eorfound, whitespace, valfound, decfound, eoffound
   s2 = ""
   valfound = .false.
   decfound = .false.
   eorfound = .false.
   eoffound = .false.
   do
      read(Handle, fmt="(A1)",  advance = 'no', eor=2, end=3) s
      if(ichar(s(1:1)) == 9) s = ""
      whitespace = (lrtrim(s) == "")
      if(lrtrim(s) == ".") decfound = .true.
      if (.not. whitespace) then
         valfound = .true.
      endif
      if (valfound .and. whitespace) exit
      s2 = lrtrim(s2) // lrtrim(s)
   enddo
   eorfound = .false.
   goto 1
   2 eorfound = .true.
   3 eoffound = .true.
   1 ReadSFromFile = eorfound
end function ReadSFromFile


function ReadIFromFile(Opt, Handle, I, L, H, ElmName, ExpectEOF)
   implicit none
   type(TOptimisation) :: Opt
   integer :: Handle
   integer :: I, L, H
   character(len=*) :: ElmName
   logical :: ReadIFromFile
   logical, optional :: ExpectEOF
   double precision :: F
   F = dble(I)
   ReadIFromFile = ReadFFromFile(Opt, Handle, F, dble(L), dble(H), ElmName, ExpectEOF, &
      AsInt = .true.)
   I = aint(F)
end function ReadIFromFile 


function ReadFFromFile(Opt, Handle, F, L, H, ElmName, ExpectEOF, AsInt)
   implicit none
   type(TOptimisation) :: Opt
   integer :: Handle
   double precision :: F, L, H
   character(len=256) :: Str, StrEnd, DESCR
   character(len=*) :: ElmName
   logical :: ReadFFromFile, eorfound, decfound, eoffound, eorfoundend, decfoundend, eoffoundend
   integer :: errstat
   logical, optional :: ExpectEOF
   logical, optional :: AsInt
   logical :: ExpectEOFInt, AsIntInt
   ExpectEOFInt = .false.
   if(present(ExpectEOF)) ExpectEOFInt = ExpectEOF
   AsIntInt = .false.
   if(present(AsInt)) AsIntInt = AsInt
   DESCR = ""
   eorfound = ReadSFromFile(Handle, Str, decfound, eoffound)

   if(lrtrim(Str) == "") then
      DESCR = """" // lrtrim(ElmName) // """ is missing."
   else if(eorfound .and. (.not. ExpectEOFInt)) then
      DESCR = "Unexpected end of line after """ // lrtrim(ElmName) // """ = " // &
         lrtrim(Str) 
   else if((.not. eorfound) .and. ExpectEOFInt) then
      ! Check if this is only whitespace at the end or if there are more text
      eorfoundend = ReadSFromFile(Handle, StrEnd, decfoundend, eoffoundend)
      if(lrtrim(StrEnd) /= "") then
         DESCR = "End of line expected after """ // lrtrim(ElmName) // """ = " // &
            lrtrim(Str) 
      else
         eorfound = .true.
      endif
   endif
   
   if ((lrtrim(Str) == "") .or. (ExpectEOFInt .neqv. eorfound)) then
      errstat = 1
   else
      if (.not. decfound) then
         Str = lrtrim(Str) // ".0"
      endif
      read(Str, fmt="(F26.12)", iostat= errstat) F
      if (errstat /= 0) then
         DESCR = "Numeric input expected."
      endif
      if(.not. CheckInRange(Opt, F, L, H, DESCR, Elmname, AsIntInt)) errstat = 1
   endif
   ReadFFromFile = (errstat == 0)   
   if(errstat /= 0) then
      Opt%ErrorStr = "Reading """ // lrtrim(Opt%CurrentInputFile) // """, line no. " // &
         lrtrim(inttostr(Opt%CurrentInputLine)) // ". " // lrtrim(DESCR)
      call MessageOut(Opt, Opt%ErrorStr)
      close(Handle)
   else
      if(eorfound) then
         Opt%CurrentInputLine = Opt%CurrentInputLine + 1
      endif
   endif
end function ReadFFromFile 


function CheckRange(Opt, L, H, LS, HS)
   implicit none
   type(TOptimisation) :: Opt
   character(len=*) LS, HS
   integer :: L, H
   logical :: CheckRange
   CheckRange =  (L <= H)
   if (.not. CheckRange) then
      Opt%ErrorStr = "Reading """ // lrtrim(Opt%CurrentInputFile) // """, line no. " // &
         lrtrim(inttostr(Opt%CurrentInputLine)) // ". " // "Error in range: """ // &
         lrtrim(HS) // """=" // lrtrim(inttostr(H)) // " is less than """ // lrtrim(LS) // &
         """=" // lrtrim(inttostr(L))
   endif
end function CheckRange


function CheckInRange(Opt, N, L, H, DESCR, ElmName, AsInt)
! Checking boundaries
! [-1..-1] means [-1, 0..Inf+]
! where -1 = undefined and 0..Inf+ = all values at the pos. scale
! [L..-1] means any value above L
! [-1..H] means any value below H
! [L..H] means any value between L and H
   implicit none
   type(TOptimisation) :: Opt
   double precision :: N, L, H
   integer :: N_INT, L_INT, H_INT
   character(len = *) :: DESCR, ElmName
   character(len = 30) :: N_S, L_S, H_S
   logical :: CheckInRange , AsInt
   if((L == -1.0d0) .and. (H == -1.0d0)) then
      CheckInRange = (N == -1.0d0) .or. (N >= 0.0d0)
   else if ((L /= -1.0d0) .and. (H == -1.0d0)) then
      CheckInRange = (N >= L)
   else if ((L == -1.0d0) .and. (H /= -1.0d0)) then
      CheckInRange = (N <= H)
   else
      CheckInRange = (N >= L) .and. (N <= H)
   endif
   if (.not. CheckInRange) then
      if(AsInt) then
         N_INT = anint(N)
         L_INT = anint(L)
         H_INT = anint(H)
         N_S = inttostr(N_INT)
         L_S = inttostr(L_INT)
         H_S = inttostr(H_INT)
      else
         N_S = floattostr(N)
         L_S = floattostr(L)
         H_S = floattostr(H)
      endif
      if((L == -1.0d0) .and. (H == -1.0d0)) then
         L_S = "-1, 0"
         H_S = "->"
      else
         if (L == -1.0d0) L_S = "<-"
         if (H == -1.0d0) H_S = "->"
      endif
      DESCR = """" // lrtrim(ElmName) // """=" // lrtrim(N_S) // " is outside range boundaries [" // &
         lrtrim(L_S) // ".." // lrtrim(H_S) // "]."
   endif
end function CheckInRange


subroutine GetPreferredFormat(f, col_width, num_dec, fm)
   implicit none
   double precision :: f, limit
   integer :: col_width, num_dec, d
   character(len=20) :: fm
   limit = 10 ** dble(col_width - 1 - 3 - num_dec)
   if (abs(f) < limit) then
      fm = "(F" // lrtrim(inttostr(col_width)) // "." // lrtrim(inttostr(num_dec)) // ")"
   else
      d = max(0, col_width - 7 - 3)
      fm = "(ES" // lrtrim(inttostr(col_width)) // "." // lrtrim(inttostr(d)) // "E3)"
   endif
end subroutine GetPreferredFormat


subroutine WriteFToFile(outunit, f, col_width, num_dec, LineFeed)
   implicit none
   double precision :: f
   integer :: outunit, col_width, num_dec
   logical :: LineFeed
   character(len = 20) :: fm
   character(len = 3) :: advancestr
   call GetPreferredFormat(f, col_width, num_dec, fm)
   if (LineFeed) then
      advancestr = 'yes'
   else
      advancestr = 'no'
   endif
   write(outunit, fmt=fm, advance=lrtrim(advancestr)) f
end subroutine WriteFToFile


end module SysUtils